C/C++ Users Group Library 1996 July

home *** CD-ROM | disk | FTP | other *** search

/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_400 / 422_04 / basic.asm < prev next >

Wrap

Assembly Source File | 1994-02-14 | 63.6 KB | 1,976 lines

TITLE MICRO BASIC ************************************************************** * MICRO-BASIC * *------------------------------------------------------------* * A SMALL INTEGER BASIC INTERPRETER FOR THE 8080/8085/Z80 * * D.F. DUNFIELD JAN 25/1983 * *------------------------------------------------------------* * BASIC COMMANDS * * * * CLEAR, DATA, DIM, END, EXIT, FOR, * * GOSUB, GOSUB(N), GOTO, GOTO(N), IF/THEN, INPUT, * * LET, LIF/THEN, LIST, LOAD, NEW, NEXT, * * ORDER, PLOT, PRINT, READ, REM, RETURN, * * RUN, SAVE, SIZE, STOP, USR, <EDIT> * *------------------------------------------------------------* * BASIC OPERATORS * * * * NUMERIC: + - * % / \ & | ; ( ) < = > == -= <= >= * * CHARACTER: + = == -= * * OTHER: : # $ @ ? [ ] ( ) * *------------------------------------------------------------* * BASIC VARIABLES * * * * A - Z ......... 16 BIT SIMPLE INTEGER VARIABLES. * * A$ - Z$ ....... SIMPLE CHARACTER VARIABLES. < 36 CHARS * * A[N] - Z[N] ... 16 BIT INTEGER ARRAYS. * * @[N] .......... PSEUDO MEMORY REFERENCE ARRAY. * * @[N]$ ......... NUMERIC TO CHARACTER CONVERSION.(CHR$) * * ? ............. PSEUDO RANDOM NUMBER GENERATOR. * *------------------------------------------------------------* * MEMORY MAP * * * * 0000-03FF 1K SYSTEM MONITOR (IN ROM). * * 0400-0FFF 3K BASIC INTERPRETER (IN ROM). * * 1000-13FF 1K MEMORY MAPPED 64*16 VIDEO DISPLAY * * 1400-15FF 0.5K POINTERS, STACKS, BUFFERS. * * 1600-19FF 1K VARIABLES AND POINTERS. * * 1A00-FFFF PROGRAM AND ARRAY STORAGE. * ************************************************************** PAGE * ************************************************************** * CONSTANTS AND EQUATES ************************************************************** * * MONITOR ROUTINES * IN EQU $23F INPUT ROUTINE ADDRESS OUT EQU $162 OUTPUT ROUTINE ADDRESS CTRLC EQU $27E CONTROL-C TEST ROUTINE ADDRESS EXIT EQU $37 TERMINATION RETURN ADDRESS GETR EQU $2EB ROUTINE TO LOAD INTEL HEX FORMAT TDUMP EQU $D6 ROUTINE TO DUMP IN INTEL HEX FORMAT TON EQU $396 ROUTINE TO START TAPE TOFF EQU $3A6 ROUTINE TO STOP TAPE CURPOS EQU $37E ROUTINE TO POSITION CURSOR SPACE EQU $144 DISPLAY SPACE ON CONSOLE NL EQU $35B ROUTINE TO PRINT A <LF>, <CR> ON TERMINAL PMSG EQU $34E DISPLAY'S MSG(HL) UP TO ZERO OR <CR> * MEMORY ALLOCATION BUFF EQU $1400 START OF RAM, INPUT BUFFER IOCON EQU BUFF+$FF INPUT/OUTPUT CONFIGURATION USROUT EQU IOCON-2 USER SUPPLIED OUTPUT DEVICE VECTOR CURSOR EQU USROUT-2 CURSOR POSITION LSTCHR EQU CURSOR-2 CHARACTER UNDER CURSOR STACK EQU LSTCHR-2 MACHINE STACK TB EQU BUFF+50 TEMPORARY TEXT BUFFER XBF EQU TB+50 EXTRA TEXT BUFFER EDBUF EQU BUFF+256 EDIT BUFFER CS EQU EDBUF+$FA CONTROL STACK SPACE CSP EQU CS+1 CONTROL STACK POINTER ARYLOC EQU CSP+2 LOCATION OF ARRAYS SEED EQU ARYLOC+1 RANDOM NUMBER SEED VARS EQU SEED+2 VARIABLE SPACE RFLAG EQU VARS+52 PROGRAM RUNNING FLAG IFLAG EQU RFLAG+1 INPUTTING FLAG P EQU IFLAG+1 POINTER TO END OF EXPRESSION EFLAG EQU P+1 ASSIGNMENT FLAG DATA EQU EFLAG+1 READ/DATA POINTER LAST EQU DATA+2 LAST FREE ARRAY SPACE TEMP EQU LAST+2 TEMPORARY STORAGE TEXT EQU VARS+1024 PROGRAM AND ARRAY STORAGE DELETE EQU $7F DELETE CHARACTER PAGE * ******************************************************************** * START OF MAIN PROGRAM, FIRST INITIALIZE, INSURING WE DON'T THINK * * WE HAVE A VALID PROGRAM, ALSO CLEAR OUT HIS VARIABLES AND ARRAYS * ******************************************************************** * ORG $400 FOLLOW MONITOR BASIC MVI A,$0C CHARACTER TO CLEAR SCREEN CALL OUT CLEAR VIDEO SCREEN NEW MVI A,$FF INDICATES END OF PROGRAM STA TEXT INITIALIZE TO NO PROGRAM RESV CALL CLEAR CLEAR OUT HIS VARIABLES * RESET FLAGS, AND PROMPT WITH 'READY', SO HE WILL KNOW WE ARE LISTENING INIT LXI H,0 GET DOUBLE BYTE ZERO SHLD RFLAG INDICATE NOT RUNNING, AND NOT INPUT SHLD P INDICATE NO ASSIGNMENT DONE LXI H,RDY ADDRESS OF 'READY' MESSAGE CALL PMSG TELL HIM WE ARE READY * GET A LINE FROM CONSOLE, AND SEE WHAT HE WANTS TOP LXI SP,STACK FIX UP STACK IN CASE WE ABORTED SOMETHING CALL GLINE LET HIM GIVE US A LINE CPI $0D DID HE ONLY PRESS RETURN JZ TOP NOT GOOD ENOUGH, MAKE HIM TRY AGAIN CALL NUM DID HIS LINE START WITH A NUMBER JNC EDIT IF SO, HE IS WRITEING A PROGRAM!!! * LOOK UP COMMAND AND EXECUTE LXI B,INIT ADDRESS TO RETURN TO PUSH B SAVE SO WE CAN RETURN LXI H,KTAB-1 POINT TO COMMAND TABLE * * LOCATES COMMAND POINTED TO BY D-E IN THE COMMAND TABLE POINTED TO BY H-L * AND CHAINS TO THE COMMAND PROCESSING CODE FOR THAT COMMAND * CMD CALL PARSE1 ADVANCE TO NEXT CHARACTER TLP0 PUSH D SAVE POINTER TO START OF COMMAND CMDL INX H ADVANCE IN TABLE LDAX D GET DATA FROM COMMAND CMP M COMPARE WITH TABLE CONTENTS INX D ADVANCE IN COMMAND JZ CMDL IF SAME, KEEP TESTING * DIDN'T MATCH, SEE IF IT'S END OF WORD (HIGH BIT SET) ORI $80 ARE WE AT END? CMP M AND IS IT THIS ONE? JZ GOTCMD IF SO, WE HAVE IT * WASN'T THAT ENTRY, KEEP LOOKING SUB A SEE IT THIS IS END OF TABLE CMP M ARE WE AT END? JZ GOTDEF IF SO, WE WILL SAY WE FOUND POP D RESTORE POINTER TO COMMAND CMD1 ORA M TEST FOR AT END OF TABLE ENTRY INX H POINT TO NEXT JP CMD1 IF NO, KEEP LOOKING INX H SKIP FIRST ADDRESS BYTE JMP TLP0 TEST THIS ENTRY * WE HIT THE END OF THE TABLE, ASSUME THE DEFAULT ADDRESS (LET) GOTDEF DCX D BACKUP TO START OF WORD * WE MATCHED ALL THE WAY TO THE END OF A COMMAND WORD, GET IT'S ADDRESS GOTCMD INX H POINT TO ADDRESS BYTE MOV C,M SAVE TEMPORARY INX H POINT TO NEXT ADDRESS BYTE MOV H,M GET LOW ADDRESS MOV L,C GET HIGH ADDRESS XTHL PLACE CODE ADDRESS ON STACK, REMOVE TRASH JMP PARSE1 SKIP TO NEXT NON-BLANK, AND CHAIN TO CODE * **************************************************************** * ERROR CHECKING AND HANDLING CODE **************************************************************** * * VCHAR... TESTS FOR A VALID VARIABLE, SYNTAX ERROR IF NOT * VCHAR CALL CHAR TEST VARIABLE RNC IF OK, GO BACK * * SYNTAX ERROR... HE'S NOT MAKEING ANY SENSE AT ALL * ISSUE NASTY MESSAGE TO STRAIGHTEN HIM OUT * SYNT LXI H,SYN GET NASTY 'SYNTAX' MESSAGE DCX D BACK UP IN SOURCE SO WE DONT SAY WRONG LINE * * ERROR STUFF... SOMETHING HAS GONE WRONG... TELL HIM THE BAD NEWS AND * QUIT ANYTHING THAT WE MAY HAVE STARTED, SO THAT THINGS CAN'T GET WORSE * ALSO, IF WE WERE RUNNING, GIVE HIM THE LINE NUMBER AS A CLUE * ERR MVI A,'?' PRECEDE ERROR MESSAGE BY '?' CALL OUT DISPLAY ON TERMINAL LDA IFLAG WERE WE TRYING TO 'INPUT' SOMETHING ANA A IF WE WERE, THEN .. JNZ INERR SPECIAL MESSAGE + HANDLEING * NOW THAT WE HAVE FIGURED OUT WHAT'S GOING ON, LET HIM IN ON IT CALL PMSG PRINT ERROR MESSAGE LXI H,EM FOLLOWED BY.. * PRINT MESSAGE FOLLOWED BY LINE NUMBER (ALSO USED BY 'STOP IN LINE XXXX') PERR CALL PMSG THE ' ERROR ' PART LDA RFLAG WERE WE RUNNING.. ANA A IF NOT, JZ INLF THEN THATS ALL WE HAVE TO DO * DISPLAY LINE NUMBER OF RUNNING PROGRAM LXI H,INL ADDRESS OF 'IN LINE ' MESSAGE CALL PMSG DISPLAY FOR HIM * FIND START OF OUR LINE, AND DISPLAY LINE NUMBER FSOL DCX D BACK UP IN SOURCE MOV A,D GET HIGH BYTE OF ADDRESS CPI =TEXT TEST FOR BEYOND BEGINNING JC STLIN AT START OF LINE LDAX D GET CHARACTER FROM BUFER CPI $0D TEST FOR CARRIAGE RETURN JNZ FSOL IF NOT, KEEP LOOKING STLIN INX D ADVANCE IN SOURCE XCHG SWAP TO H-L FOR PNUM CALL PNUM PRINT AND BUFFER LINE NUMBER * COPY LINE WITH ERROR INTO OLD LINE EDIT BUFFER, INCASE HE WANTS TO FIX IT FIXIT INX H SKIP LENGTH BYTE, ADVANCE TO NEXT IN SOURCE MOV A,M GET CHARACTER FROM LINE STAX D SAVE IN BUFFER INX D ADVANCE TO NEXT IN BUFFER CPI $0D TEST FOR END-OF-LINE JNZ FIXIT IF NOT, KEEP COPYING * WAIT FOR CONSOLE INPUT, ON A NEW LINE INLF CALL NL ADVANCE A LINE ON HIS TERMINAL CALL RESET RESET DATA POINTER AND CONTROL-STACK JMP INIT GET NEXT COMMAND * * SUBROUTINE TEST FOR VALID ASCII DIGIT (0-9), RETURNS WITH C=1 IF NOT * NUM CPI '0' TEST FOR < '0' RC IF SO, BAD DIGIT CPI $3A TEST FOR >'9' CMC INVERT LOGIC, C=1 IF BAD RET * **************************************************************** * TEXT EDITING ROUTINES **************************************************************** * * SUBROUTINE TO GET AND EDIT COMMAND LINE FROM TERMINAL * BADLN CALL NL ADVANCE TO NEW LINE GLINE LXI D,BUFF POINT TO INPUT BUFFER LXI H,EDBUF POINT TO EDIT BUFFER MOV B,E CLEAR INSERT FLAG (LOW ADR OF BUFFER IS ZERO) LOOP1 MOV A,E GET LOW ADDRESS OF OUR POSITION ANA A TEST FOR NEGATIVE JM BADLN IF SO, HE'S DELETED BEYOND START OF BUFFER CALL IN GET A CHARACTER CPI 3 TEST FOR CONTROL-C (CANCEL) JZ INLF IF SO, ABORT BACK TO COMMAND HANDLER CPI 6 TEST FOR CONTROL-F (FIND COMMAND) JZ GFIND EXECUTE FIND CPI 1 TEST FOR CONTROL-A (ADVANCE COMMAND) JZ GADV EXECUTE ADVANCE CPI 9 TEST FOR CONTROL-I (TOGGLE INSERT MODE) JZ GINST TOGGLE INSERT MODE CPI 4 TEST FOR CONTROL-D (DELETE CHARACTER.) JZ GRUB ERASE CHARACTER CPI ' ' TEST FOR CONTROL-CHARACTER JNC OKPRT IF NOT, OK TO PROCESS CPI $0D CARRIAGE RETURN IS OK, JZ OKPRT SO PROCESS IT CPI 8 SO IS A BACKSPACE JNZ LOOP1 ANYTHING ELSE SHOULD BE IGNORED * WE HAVE GOTTEN A VALID CHARACTER OKPRT CPI DELETE TEST FOR DELETE CHARACTER JNZ RECT IF IT IS A DELETE, MVI A,8 MAKE IT INTO A BACKSPACE RECT MOV C,A COPY INTO C CALL OUT DISPLAY ON TERMINAL DCX D ASSUME DELETE (BACKSPACE) * DON'T DELETE CHARS FROM OLD LINE BUFFER IF WE ARE INSERTING ORA B TEST INSERT FLAG JM IND IF NOT, WE ARE INSERTING DCX H REDUCE OLD BUFFER POSITION IND MOV A,C GET CHARACTER BACK CPI 8 TEST FOR DELETE (BACKSPACE) JZ LOOP1 IF SO, WE WERE RIGHT, GET NEXT CHARACTER INX D FIX OUR MISTAKE (NOT DELETE) STAX D SAVE CHARACTER IN BUFFER * DON'T MOVE OLD LINE POINTER IF WE ARE INSERTING ORA B TEST INSERT FLAG JM INOK IF SO, DON'T INCREMENT INX H ADVANCE IN OLD LINE BUFFER MOV A,M GET CHARACTER FROM OLD LINE CPI $0D TEST FOR END OF OLD LINE JZ INOK IF SO, DON'T GO PAST IT INX H ADVANCE TO NEXT CHARACTER OF OLD LINE INOK MOV A,C GET CHARACTER BACK INX D ADVANCE POINTER IN NEW LINE CPI $0D TEST FOR CARRAIGE RETURN (END OF LINE) JNZ LOOP1 IF NOT, KEEP GETTING CHARACTERS CALL NL PRINT LINE-FEED CARRIAGE RETURN * COPY NEW LINE INTO OLD LINE BUFFER (MAKEING IT THE 'NEW' OLD LINE) LXI D,BUFF POINT BACK TO NEW LINE BUFFER PUSH D SAVE BUFFER ADDRESS LXI H,EDBUF POINT TO OLD LINE BUFFER MOVL LDAX D GET CHARACTER FROM NEW LINE MOV M,A SAVE IN OLD LINE BUFFER INX H POINT TO NEXT INX D POINT TO NEXT CPI $0D TEST FOR END OF LINE JNZ MOVL IF NOT, KEEP MOVEING POP D RESTORE BUFFER ADDRESS LDAX D AND FIRST CHARACTER FROM IT RET * COPY ONE CHARACTER FROM OLD LINE TO NEW LINE GADV MOV A,M GET CHARACTER FROM OLD LINE CPI $0D INSURE ITS NOT THE END JZ LOOP1 IF SO, IGNORE COMMAND ORA B TEST INSERT FLAG MOV A,M GET CHARACTER BACK JP RECT IF NO INSERT, OK INX H ADVANCE TO NEXT JMP RECT PASS CHARACTER TO INPUT ROUTINE * RUB OUT ONE CHARACTER FROM THE OLD LINE GRUB MOV A,M GET CHARACTER FROM OLD LINE CPI $0D TEST FOR END OF LINE JZ LOOP1 IF SO, IGNORE COMMAND MVI A,'*' INDICATE RUBBED OUT CHARACTER WITH '*' CALL OUT PRINT IT TO SHOW WHAT WE ARE DOING INX H ADVANCE PASSED CHARACTER (RUBBING IT OUT) JMP LOOP1 RETURN FOR NEXT CHARACTER * FIND NEXT CHARACTER IN NEW LINE GFIND CALL IN GET A CHARACTER MOV C,A SAVE IN C (TO COMPARE AGAINST.) PUSH H SAVE POSITION IN OLD LINE * FIND OUT IF IT IS THERE.. GF1 MOV A,M GET CHARACTER FROM OLD LINE GF0 CPI $0D TEST FOR END OF LINE JZ ABFND IF SO, WE DIDN'T FIND IT INX H ADVANCE TO NEXT CHARACTER MOV A,M GET CHARACTER CMP C TEST FOR CHARACTER WE DESIRE JNZ GF0 IF NOT, KEEP LOOKING POP H RESTORE POSITION ON OLD LINE * NOW COPY OLD LINE OVER.. GF2 MOV A,M GET CHARACTER FROM OLD LINE GF3 STAX D SAVE IN NEW LINE CALL OUT DISPLAY ON TERMINAL INX H POINT TO NEXT CHAR. IN OLD LINE INX D POINT TO NEXT CHAR IN NEW LINE MOV A,M GET NEXT CHAR FROM NEW LINE CMP C TEST FOR CHARACTER WE WANT JNZ GF3 IF NOT, KEEP COPYING PUSH H FIX UP STACK ABFND POP H RESTORE POSITION IN OLD LINE JMP LOOP1 GET NEXT CHARACTER * TOGGLE INSERT MODE GINST MOV A,B GET INSERT MODE FLAG XRI $FF COMPLEMENT, SETTING FLAGS MOV B,A REAVE IN FLAG REGISTER MVI A,'<' INDICATE ENTERING INSERT MODE JM GIN1 IF SO, INDICATE SO MVI A,'>' INDICATE LEAVING INSERT GIN1 CALL OUT DISPLAY INDICATOR ON TERMINAL JMP LOOP1 GET NEXT CHARACTER FROM TERMINAL * * GET A PACKED-DECIMAL LINE NUMBER FROM THE COMMAND BUFFER * GETLN LXI H,0 START WITH ZERO ELOOP LDAX D GET DIGIT FROM COMMAND BUFFER CALL NUM TEST FOR ASCII DIGIT RC IF NOT, STOP (WE HAVE IT) INX D ADVANCE TO NEXT BUFFER POSITION DAD H MAKE ROOM FOR DIGIT IN BOTTOM.. DAD H OF THE RESULT, BY .. DAD H ROTATING IT.. DAD H LEFT BY FOUR BITS ANI $0F CONVERT DIGIT TO BINARY ORA L INSERT INTO LOWER DIGITS OF RESULT MOV L,A AND REPLACE BYTE IN RESULT WITH NEW VALUE JMP ELOOP GET NEXT DIGIT * * LINE EDITOR, EDITS PROGRAM SOURCE BY LINE NUMBER IN COMMAND BUFFER * EDIT CALL LINEF LOCATE LINE NUMBER IN SOURCE PUSH H SAVE POINTER INTO TEXT JNZ INS IF NEW LINE, DON'T TRY TO DELETE * DELETE LINE POINTED TO BY H-L DEL MOV D,H COPY POINTER INTO MOV E,L THE D-E PAIR FOR BACKWARDS COPY MVI A,$0D WE ARE LOOKING FOR A CARRIAGE RETURN * FIND START OF NEXT LINE DELNX CMP M TEST FOR END OF LINE TO DELETE INX H POINT TO NEXT CHARACTER IN SOURCE JNZ DELNX IF NOT END OF LINE, KEEP LOOKING * COPY REST OF PROGRAM BACK OVER DELETED LINE DELLP MOV A,M GET CHARACTER FROM NEXT LINE STAX D SAVE OVER DELETED LINE INX D POINT TO NEXT IN NEW LINE INX H POINT TO NEXT IN OLD LINE INR A TEST FOR END OF FILE JNZ DELLP IF NOT, KEEP DELETEING * INSERT LINE INTO TEXT INS LXI B,2 SET LENGTH TO 2 (PACKED DECIMAL NUMBERS ARE 2) LXI D,BUFF POINT TO BUFFER (CONTAINING NEW LINE) * CALCULATE LENGTH OF LINE CALL GETLN REMOVE NUMBERS AS THEY ARE NOT STORED AS TEXT ILP INR C INCREMENT LENGTH LDAX D GET CHARACTER FROM NEW LINE (IN BUFFER) INX D POINT TO NEXT CHARACTER FROM NEW LINE CPI $0D TEST FOR END OF LINE JNZ ILP IF NOT, KEEP COUNTING MOV A,C GET LENGTH POP H RESTORE POSITION IN TEXT CPI 3 TEST FOR NULL LINE JZ TOP IS SO, DON'T INSERT * INSERT NEW LINE INTO TEXT INLN MOV D,H SET D-E TO POINT TO MOV E,L THE LINE POSITION CALL GETEOF GET END OF FILE ADDRESS INX H ADVANCE TO FREE BYTE PUSH B SAVE LENGTH PUSH H STACK END OF FILE ADDRESS DAD B ADD LENGTH POP B GET END OF FILE ADDRESS INX H ADVANCE BECAUSE WE DECREMENT IL01 DCX H REDUCE POINTER INTO NEW POSITION DCX B REDUCE POINTER TO OLD POSITION LDAX B GET BYTE OF OLD DATA MOV M,A SAVE IN NEW POSITION MOV A,C GET LOW ADDRESS CMP E TEST AGAINST WHERE WE ARE GOING JNZ IL01 IF NOT, KEEP COPYING MOV A,B GET HIGH ADDRESS CMP D TEST AGAINST DESTINATION JNZ IL01 IF NOT SAME, KEEP COPYING LXI D,BUFF GET ADDRESS OF NEW LINE CALL GETLN OBTAIN NUMBERS MOV A,H GET HIGH 2 DIGITS STAX B SAVE IN NEW LINE INX B POINT TO NEXT CHARACTER OF NEW LINE MOV A,L GET LOW DIGITS STAX B SAVE IN NEW LINE INX B ADVANCE TO NEXT CHARACTER IN NEW LINE POP H RESTORE LENGTH MOV A,L GET LENGTH ADI $10 ADD OFFSET TO MAKE UNIQUE STAX B SAVE IN NEW LINE INX B POINT TO NEXT CHARACTER IL02 LDAX D GET CHARACTER FROM NEW LINE IN BUFFER STAX B SAVE IN TEXT INX B POINT TO NEXT POSITION IN TEXT INX D ADVANCE IN BUFFER CPI $0D TEST FOR END OF LINE JNZ IL02 IF NOT, KEEP LOOKING * WE ARE INSERTING OR REPLACEING A LINE, SINCE WE DON'T KNOW HOW MUCH * MEMORY IT WILL REQUIRE, WE MUST CLEAR THE ARRAYS, AS THEY FOLLOW THE * PROGRAM. WE DO NOT HAVE TO DO THIS WHEN DELETING LINES CALL CLRARY CLEAR ARRAYS AND RETURN JMP TOP GO BACK FOR NEXT COMMAND * * LOCATE LINE IN TEXT, SYNTAX ERROR IF NOT LINE NUMBER * FNDLIN CALL NUM IS IT A VALID NUMBER JC SYNT IF NOT, IT'S A INVALID * * FINDS LINE IN PROGRAM TEXT. RETURNS WITH Z FLAG SET IF LINE EXISTS * H-L POINTS TO START OF LINE. B-C CONTAINS LINE NUMBER OF ACTUAL * LINE FOUND. (IF LINE NOT FOUND, POINTS TO FIRST GREATER LINE NUMBER) * LINEF CALL GETLN GET LINE NUMBER FROM COMMAND BUFFER XCHG SWAP TO D-E LXI H,TEXT START AT TOP OF PROGRAM TRY MOV A,M GET FIRST CHARACTER FROM PROGRAM LINE CPI $FF TEST FOR END OF FILE JZ EOF IF SO, WE DIDN'T FIND INX H ADVANCE POINTER TO LOW DIGITS CMP D TEST FOR HIGH DIGITS CORRECT JC NEXTL IF LESS, FIND NEXT LINE JNZ NOTFND IF GREATER, LINE WASN'T FOUND MOV A,M GET LOW DIGITS CMP E TEST LOW DIGITS JNC NOTFND IF LESS, LINE IS HERE OR DOSN'T EXIST * ADVANCE TO NEXT LINE IN SOURCE NEXTL INX H POINT TO LINE LENGTH MOV A,M GET LENGTH SUI $11 SUBTRACT OFFSET USED TO MAKE IT UNIQUE ADD L ADD TO POINTER MOV L,A AND REPLACE IN POINTER JNC TRY IF NO CARRY, THATS IT INR H BUMP HIGH ADDRESS JMP TRY AND TEST THIS LINE * LINE IS HERE OR BEFORE NOTFND DCX H BACK UP TO DIGIT MOV C,A PLACE LOW ORDER DIGIT IN C MOV B,M PLACE HIGH ORDER DIGIT IN B CMP E TEST FOR LINE FOUND RNZ IF NOT SAME, RETURN INDICATING SO MOV A,B GET HIGH DIGIT CMP D INDICATE IF NUMBERS SAME RET * LINE WAS GREATER THAN ALL LINES IN PROGRAM, INDICATE EOF REACHED EOF MOV B,A RETURN HIGH LINE NUMBER ANA A INDICATE LINE DOSN'T EXIST RET * * PRINTS PACKED-DECIMAL LINE NUMBER ON TERMINAL, AS WELL AS PLACEING * IT AT THE START OF THE EDIT BUFFER * PNUM LXI D,EDBUF SET UP POINTER TO EDIT BUFFER CALL HPOUT PRINT FIRST TWO DIGITS HPOUT MOV A,M GET CONTENTS OF MEMORY INX H AND POINT TO NEXT PUSH PSW SAVE FOR LATER RRC ROTATE RRC UPPER DIGIT RRC INTO RRC LOWER DIGIT CALL POUT DISPLAY UPPER DIGIT POP PSW GET LOWER DIGIT BACK * DISPLAYS ONE DIGIT POUT ANI $0F REMOVE UPPER GARBAGE ORI $30 CONVERT TO ASCII DIGIT STAX D SAVE IN EDIT BUFFER INX D ADVANCE POINTER IN EDIT BUFFER JMP OUT DISPLAY DIGIT ON TERMINAL AND RETURN * ****************************************************************** * BASIC COMMAND HANDLERS ****************************************************************** * * IT'S A 'LIST' COMMAND, LETS GIVE HIM A PEEK AT THE SOURCE * ALSO PLACE LAST LINE LISTED IN BUFFER, INCASE HE WANTS TO EDIT IT * LIST PUSH D SAVE PROGRAM POINTER LXI H,TEXT START AT THE BEGINNING OF THE PROGRAM MVI B,255 SET ENDING LINE BEYOND END OF TEXT LDAX D GET CHARACTER OF OPERAND CALL NUM TEST FOR A NUMBER JC GO IF NOT, LIST WHOLE THING CALL GETLN GET LINE NUMBER PUSH H SAVE ON STACK INX D POINT TO NEXT CHARACTER CPI ',' TEST FOR ENDING NUMBER CZ LINEF IF SO, GET ENDING NUMBER INX H ADVANCE PAST BEGINNING OF LINE POP D GET STARTING LINE NUMBER BACK PUSH H SAVE ENDING LINE CALL LINEF+4 FIND STARTING LINE ADDRESS POP B GET ENDING ADDRESS BACK * LIST TEXT FROM STARTING LINE IN H-L TO ENDING LINE IN B-C GO MOV A,M GET CHARACTER FROM START OF LINE INR A TEST FOR END OF FILE JZ LIRET IF SO, STOP LISTING CALL PNUM DISPLAY LINE NUMBER AND BUFFER IT INX H SKIP LENGTH BYTE, AS IT DOSN'T LOOK PRETTY PRINS MOV A,M GET CHARACTER FROM LINE STAX D PLACE INTO BUFFER INX D ADVANCE IN BUFFER CALL OUT DISPLAY ON TERMINAL INX H ADVANCE POINTER IN PROGRAM CPI $0D TEST FOR END OF LINE JNZ PRINS IF NOT, KEEP PRINTING CALL NL NEW LINE ON TERMINAL CALL COMP TEST FOR LAST LINE LISTED JNC LIRET IF SO, STOP LISTING CALL CTRLC TEST FOR ABORT FROM TERMINAL JNZ GO KEEP LISTING IF NOT LIRET POP D RESTORE PROGRAM POINTER RET * * CLEARS VARIABLES AND ARRAYS. (INITIALIZES THEM) AND INITIALIZES EDIT BUFFER * CLEAR LXI H,VARS POINT TO VARIABLE SPACE MVI A,$0D GET A CARRIAGE RETURN (END OF LINE CHARACTER) STA EDBUF INITIALIZE EDIT BUFFER TO A NULL LINE MVI C,52 26 VARIABLE TIMES 2 BYTES/VARIABLE CVLP MVI M,0 CLEAR INTEGER VARAIBLES TO ZERO INX H ADVANCE TO NEXT BYTE OF VARIABLE SPACE DCR C REDUCE COUNT OF VARAIABLES LEFT JNZ CVLP KEEP GOING TILL ALL INTEGERS ARE ZERO'ED MVI A,=VARS+$400 ADDRESS OF END OF VARIABLE TABLE LXI B,10 SKIP AHEAD 10 BYTES DAD B SO THAT WE DON'T CLOBBER OUR FLAGS CVL1 MVI M,255 $FF IS NULL CHARACTER FOR CHAR. VARS INX H POINT TO NEXT BYTE IN CHAR. VAR. SPACE CMP H TEST FOR COMPLETE (ALL SET TO NULL STRINGS) JNZ CVL1 KEEP GOING TILL WE DO THEM ALL * INITIALIZE ARRAYS, RESET ARRAY SPACE TO FIRST PAGE FOLLOWING PROGRAM CLRARY CALL GETEOF GET ADDRESS OF FIRST FREE PAGE+SET POINTER STA ARYLOC STASH IN ARRAY TABLE POINTER MOV H,A PLACE IN H, SO WE CAN REFERENCE INDERECT MVI L,52 START AT END OF TABLE SHLD LAST INDICATE FREE SPACE FOR NEXT ARRAY SUB A GET A ZERO CALS DCR L BACK UP IN TABLE MOV M,A INITIALIZE TO INDICATE NO ARRAY JNZ CALS KEEP GOING TILL TABLE IS CLEARED * RESET CONTROL STACK AND DATA POINTER RESET LXI H,CS GET USER STACK POINTER SHLD CSP INITIALZE USER STACK POINTER LXI H,0 GET A ZERO (NO DATA POINTER) SHLD DATA INSURE NO DATA PRESENT RET * * ** WE'VE GOTTEN A 'RUN' COMMAND, LETS START THE PROGRAM ROLLING ** * RUN LDA TEXT GET FIRST CHARACTER OF PROGRAM LXI H,NP AND ADDRESS OF 'NO PROGRAM' MESSAGE INR A TEST FOR EXISTANCE OF PROGRAM JZ ERR IF NOT, POINT OUT HIS MISTAKE CALL CLEAR CLEAR VARIABLES AND ARRAYS LXI D,TEXT START INTERPRETING AT THE BEGINNING RGON MVI A,255 INDICATE THAT WE ARE RUNNING STA RFLAG BY SETTING THIS FLAG RNEWL INX D SKIP PACKED DECIMAL LINE INX D NUMBERS, AND THE LENGTH BYTE, INX D AS THE COMMAND FINDER WON'T LIKE IT * MAIN 'RUN' INTERPRETING LOOP RLOOP LXI SP,STACK REPAIR ANY DAMAGE CALL CTRLC TEST FOR 'MAGIC' CONTROL-C CHARACTER JZ STOP IF SO, FAKE A 'STOP' COMMAND LXI H,PTAB-1 POINT TO PROGRAM COMMAND TABLE CALL CMD RUN PROGRAM CODE * ADVANCE TO NEXT STATEMENT RNEXT LDAX D GET CHARACTER FROM SOURCE CPI $22 TEST FOR A QUOTE CZ SKPQUO IF SO, SEARCH FOR NEXT ONE INX D ADVANCE TO NEXT CHARACTER CPI ':' TEST FOR COLON (NEW STATEMENT) JZ RLOOP IF SO, EXECUTE NEXT COMMAND CPI $0D TEST FOR CARRIAGE RETURN JNZ RNEXT IF NOT, KEEP LOOKING LDAX D GET FIRST CHAR OF NEW LINE INR A TEST FOR $FF (END OF FILE) JZ INIT IF SO, GO BACK TO COMMAND MODE JMP RNEWL EXECUTE THIS LINE * * EITHER WE HAVE GOTTEN A 'STOP' COMMAND, OR THE OPERATOR PRESSED * CONTROL-C, EITHER WAY, PRINT THE MESSAGE AND EXIT * STOP LXI H,STMSG ADDRESS OF 'STOP' MESSAGE JMP PERR TREAT IT LIKE AN ERROR * IT'S A 'THEN', FOLLOWING AN 'IF', LOOK FOR LINE NUMBER OR A STATEMENT THEN CALL NUM IS IT A NUMBER? JNC GOTO IF SO, ITS A NUMBER TO 'GOTO' JMP RLOOP IF NOT, ITS A STATEMENT TO EXECUTE * * IT'S A 'GOSUB' SAVE RETURN ADDRESS, AND PRETEND IT'S 'GOTO' * GOSUB CALL PUSHD SAVE SOURCE POSITION SUB A INDICATE GOSUB ENTRY CALL PUSHS SAVE ON USER STACK LDAX D RESTORE OPERAND CHARACTER * * IT'S A 'GOTO' MAKE THE BIG JUMP * GOTO CPI '(' TEST FOR COMPUTED GOTO JNZ NOON IF NO, NOT AN 'ON' STATEMENT CALL EXPR GET VALUE OF INTERNAL EXPRESSION GLPO CALL SKIP SKIP TO NEXT EXPRESSION CPI ',' IF THERE IS NO MORE COMMA'S JNZ SYNT THEN WE RAN OUT OF OPERANDS GLPD INX D SKIP THE COMMA DCR L REDUCE OUR COUNT JP GLPO IF IT'S STILL POSITIVE, KEEP SKIPPING LDAX D GET CHARACTER FROM SOURCE CPI ' ' TEST FOR BLANKS JZ GLPD AND KEEP GOING TILL WE SKIP THEM NOON PUSH D SAVE POSITION (IN CASE WE FAIL) CALL FNDLIN FIND THE LINE HE WANTS POP D RESTORE OUR POSITION XCHG SWAP NEW POS INTO D-E JZ RGON IF SUCESS, GOTO NEW LINE XCHG SWAP BACK * * OH OH, LOOKS LIKE HE'S TRIED TO GOTO, GOSUB OR ORDER TO A LINE HE FORGOT * TO TYPE IN, TELL HIM ABOUT IT AND LET HIM TRY TO FIGURE IT OUT * BADLIN LXI H,LIN ADDRESS OF 'LINE NUMBER' MESSAGE JMP ERR HANDLE LIKE ANY ERROR * * IT'S A 'RETURN', HOPE SOMEBODY DID A 'GOSUB' SOMEWHERE * RETURN CALL POPS GET TYPE OF STACK ENTRY ANA A TEST FOR 'GOSUB' ENTRY JZ POPD IF SO, GET ADDRESS BACK AND RETURN * * HE SCREWED UP THE FOR/NEXT, GOSUB/RETURN NESTING * LET HIM IN ON IT AND DIE WHILE WE CAN * NSTERR LXI H,CSTK ADDRESS OF 'NESTING' MESSAGE JMP ERR HANDLE LIKE ANY ERROR * * IT'S A 'FOR' COMMAND, LETS THROW THIS THING FOR A LOOP * FOR CALL VCHAR INSURE IT'S A VARIABLE PUSH PSW SAVE IT (IT'S THE LOOP INDEX VARIABLE) DCX D BACK UP POINT JUST BEFORE EXPRESSION MOV A,E GET LOW ADDRESS STA P AND PLACE IN POSITION FLAG FINTO LDAX D GET CHARACTER FROM SOURCE CPI $0D TEST FOR END OF LINE JZ SYNT IF SO, HE'S GOOFED INX D SKIP TO NEXT CPI 'T' TEST FOR A 'T' JNZ FINTO IF NOT, WE ARN'T THERE YET LDAX D GET NEXT CHARACTER CPI 'O' IS IT 'TO' JNZ FINTO NO, MUST BE VARIABLE 'T' PUSH D SAVE OUR POSITION DCX D BACKUP TO THE 'T' CALL DOEXP EVALUATE EXPRESSION POP D RESTORE OUT POSITION INX D SKIP 'O' CALL EXPR GET LIMIT EXPRESSION CALL PUSHD SAVE OUR POSITION ON STACK XCHG GET LIMIT VALUE CALL PUSHD SAVE ON STACK XCHG GET POSITION BACK POP PSW GET INDEX VARIABLE NAME * * SAVES A SINGLE BYTE ENTRY ON THE USER (CONTROL) STACK * PUSHS PUSH H SAVE H-L LHLD CSP GET STACK POINTER MOV M,A SAVE BYTE ON STACK PSH1 DCX H REDUCE POINTER PSH2 SHLD CSP RESAVE STACK POINTER POP H RESTORE H-L RET * * POP A SINGLE BYTE ENTRY FROM THE USER (CONTROL) STACK * POPS PUSH H SAVE H-L LHLD CSP GET STACK POINTER INX H ADVANCE TO NEXT ENTRY MOV A,M GET BYTE BACK JMP PSH2 SAVE POINTER AND CONTINUE * * PUSHES A DOUBLE BYTE ENTRY ON THE USER (CONTROL) STACK * PUSHD PUSH H SAVE H-L LHLD CSP GET STACK POINTER MOV M,D SAVE HIGH BYTE DCX H BACK UP MOV M,E SAVE LOW BYTE JMP PSH1 SAVE POINTER AND CONTINUE * * POPS A DOUBLE BYTE ENTRY FROM THE USER STACK * POPD PUSH H SAVE H-L LHLD CSP GET STACK POINTER INX H ADVANCE TO LAST ENTRY MOV E,M GET LOW BYTE INX H ADVANCE TO HIGH BYTE MOV D,M GET HIGH BYTE JMP PSH2 SAVE AND CONTINUE * * LET COMMAND, EVALUATE EXPRESSION * LET CALL EXPR EVALUATE EXPRESSION LDA EFLAG DID HE MAKE AN ASSIGNMENT? ANA A IF NOT.. JZ SYNT HE'S MADE ANOTHER MISTAKE SUB A RESET THE FLAG STA EFLAG SO WE KNOW WHEN HE SCREW'S UP AGAIN RET * * IT'S A NEXT COMMAND, TEST INDEX AGAINST LIMIT, AND LOOP IF NEEDED * NEXT CALL VCHAR TEST FOR VALID VARIABLE MOV B,A STASH IN B FOR SAFEKEEPING LHLD CSP SAVE CONTROL STACK POINTER.. SHLD TEMP IN CASE WE NEED TO LOOP AGAIN CALL POPS GET VARIABLE NAME FROM STACK CMP B TEST FOR WHAT HE GAVE US JNZ NSTERR IF NOT, HE'S SCREWED UP THE NESTING CALL LOOK GET VARIABLE VALUE PUSH D SAVE POSITION CALL POPD GET LIMIT FROM STACK MOV B,D GET LIMIT MOV C,E INTO B-C SO WE CAN 'COMP' CALL COMP TEST IF INDEX >= LIMIT JNC NOMORE IF SO, DON'T LOOP ANYMORE POP D GET POSITION BACK INX H INCREMENT LOOP INDEX LDAX D GET VARIABLE NAME BACK CALL STOR SAVE IT AWAY CALL POPD GET NEW POSITION LHLD TEMP GET CONTROL-STACK POINTER SHLD CSP AND REPLACE IT (LEAVING STACK UNCHANGED) RET * WE HAVE HIT THE END OF A FOR NEXT LOOP NOMORE CALL POPD CLEAN UP CONTROL STACK POP D GET PROGRAM COUNTER BACK * * REMARK, DO NOTHING, BUT RETURN, ALLOWING 'RNEXT' TO SKIP THE COMMAND * REM RET * * IT'S AN 'IF' STATEMENT. FIND OUT 'IF' WE DO IT OR NOT * IF DCX D BACK UP IN SOURCE MOV A,E GET LOW ADDRESS STA P SAVE IN POSITION POINTER FTHEN LDAX D GET CHARACTER FROM SOURCE CPI $0D IF IT'S A CARRIAGE RETURN.. JZ SYNT THEN HE DIDN'T TYPE IN A 'THEN' INX D ADVANCE TO NEXT CHARACTER CPI 'T' IS IT A 'T'? JNZ FTHEN IF NOT, IT AINT THE START OF 'THEN' LDAX D GET NEXT CHARACTER CPI 'H' TEST FOR NEXT CHARACTER OF 'THEN' JNZ FTHEN NO, MUST BE VARIABLE 'T' (OR HE CAN'T SPELL) DCX D BACK UP TO 'T' PUSH D SAVE POSITION IN SOURCE CALL DOEXP EVALUATE CONDITION EXPRESSION POP D GET POSITION BACK MOV A,H GET RESULT AND TEST. ORA L IT FOR ZERO (FALSE) RZ IF SO, SKIP THIS STATEMENT JMP RLOOP EXECUTE THE 'THEN' * * LONG IF, CONTROLS REMAINDER OF ENTIRE LINE * LIF CALL IF CALCULATE AND PROCESS IF TRUE LNXT INX D ADVANCE IN SOURCE LDAX D GET CHARACTER FROM SOURCE CPI $0D TEST FOR END OF LINE JNZ LNXT KEEP LOOKING RET * * IT A 'PLOT' COMMAND, (HE'S PLOTTING AGAINST US) * PLOT CALL EXPR GET X COORDINATE JC SYNT IF CHARACTER, IT'S NO GOOD PUSH H SAVE X COORDINATE INX D ADVANCE PAST ',' CALL EXPR GET Y COORDINATE POP B GET X POSITION IN B-C DAD H MULTIPLY. DAD H Y POSITION. DAD H BY 64. DAD H TO PLACE ADDRESS. DAD H ON PROPER LINE. DAD H OF THE DISPLAY DAD B ADD IN X POSITION LXI B,1024 TEST AGAINST END OF SCREEN CALL COMP TO SEE IF WE ARE OVER JNC DIMERR IF SO, 'DIMENSION ERROR' CALL CURPOS POSITION THE CURSOR * LOOK FOR END OF LINE, OR OTHER OPERANDS CALL SKIP GET NEXT SEPERATOR CPI ',' TEST FOR COMMA RNZ IF NOT, WE ARE DONE INX D SKIP ',' * * PRINT STATEMENT, LET'S OUTPUT SOMETHING SO HE WON'T GET UPSET * WHILE STAREING AT THE TUBE WONDERING IF WE DIED * PRINT CALL EXPR GET EXPRESSION TO PRINT PUSH D SAVE BASIC'S PROGRAM COUNTER CNC DECPRT IF NUMERIC, OUTPUT DECIMAL NUMBER POP D RESTORE BASIC'S PROGRAM COUNTER CC PV1 IF CHARACTER, DISPLAY CHARACTER VALUE LDAX D GET CHARACTER FROM SOURCE CPI ',' TEST FOR COMMA JNZ NL IF NOT, IT'S THE END CALL PARSE ADVANCE TO NEXT NON-BLANK JNZ PRINT PRINT NEXT EXPRESSION RET * PRINT CHARACTER EXPRESSIONS PV1 LXI H,XBF EXPRESSION IS IN EXTRA BUFFER PZ MOV A,M GET CHARACTER FROM EXPRESSION INX H POINT TO NEXT ANA A TEST FOR END OF EXPRESSION RM IF SO, END IT NOW CALL OUT PRINT CHARACTER JMP PZ KEEP GOING TILL END * RECURSIVE ROUTINE OUTPUTS NUMBER IN DECIMAL DECPRT CPI '(' TEST FOR SPECIAL CASE CNZ SPACE IF NOT, PRECEDE WITH SPACE DECP1 LXI B,10 DIVIDE BY 10 CALL DODIV PERFORM DIVISION MVI A,$30 TO CONVERT TO ASCII ADD L GET DIGIT PUSH PSW SAVE FOR OUTPUT XCHG SWAP, REMAINDER IS NOW IN HL MOV A,H GET HIGH BYTE ORA L TEST FOR ZERO, (FINISHED) CNZ DECP1 IF NOT, GET NEXT VALUE POP PSW GET DIGIT OFF STACK JMP OUT DISPLAY AND RETURN * * IT'S AN 'INPUT', LETS GIVE HIM A CHANCE TO DO SOME TYPING.. BUT * KEEP AN EYE ON HIM, IN CASE HE TRY'S TO PUT SOMETHING OVER ON US * INPUT CALL CLBF CLEAR EXTRA TEXT BUFFER MVI A,'?' GET A QUESTION MARK. STA XBF TO USE AS THE DEFAULT PROMPT LDAX D GET FIRST CHAR OF OPERAND CPI $22 TEST FOR USER SUPPLIED PROMPT JNZ INP1 IF NOT, DON'T CHANGE EXISTING ONE CALL EXPR EVALUATE USER SUPPLIED PROMPT CALL PARSE SKIP TO NEXT NON-BLANK INP1 CALL VCHAR TEST FOR VALID VARIABLE NAME PUSH D SAVE SOURCE POSITION INX D ADVANCE TO NEXT CHARACTER PUSH PSW SAVE VARIABLE NAME LDAX D GET NEXT CHARACTER CPI '$' TEST FOR CHARACTER INPUT JZ GCHR IF SO, GET CHARACTER DATA LXI H,0 START WITH A ZERO DAD SP AND GET STACK POINTER. IN CASE WE BLOW UP SHLD TEMP SAVE SO WE CAN GET IT BACK LATER RETRY CALL PV1 DISPLAY USER PROMPT SUB A GET A ZERO STA IFLAG AND CLEAR THE INPUT FLAG (IN CASE HE CTRL-C'S) CALL GLINE GET A LINE FROM THE TERMINAL STA IFLAG SET IFLAG. (SO GET ERROR, WE CAN COME BACK) CALL EXPR EVALUATE EXPRESSION POP PSW RESTORE VARAIABLE NAME CALL STOR STASH VALUE IN VARIABLE POP D RESTORE SOURCE POSITION SUB A GET A ZERO STA IFLAG AND CLEAR IFLAG RET * CHARACTER INPUT GCHR CALL PV1 DISPLAY USER PROMPT CALL GLINE GET A LINE OF INPUT POP PSW GET VARIABLE BACK CALL LTA GET THE TEXT VARIABLE'S ADDRESS MVI B,35 LENGTH IS 35 Z1 LDAX D GET CHARACTER FROM INPUT BUFFER CPI $0D TEST FOR END OF BUFFER JZ Z2 IF SO, END THE LINE DCR B TEST FOR END OF VARIABLE SPACE JZ Z2 IF SO, END THE LINE MOV M,A SAVE IN VARIABLE SPACE INX H NEXT CHARACTER IN VARIABLE INX D NEXT CHARACTER IN INPUT BUFFER JMP Z1 COPY NEXT CHARACTER Z2 POP D RESTORE SOURCE POSITION Z3 MVI M,$FF PAD BUFFER WITH NULL CHARACTERS INX H NEXT POSITION IN VARIABLE DCR B REDUCE COUNT TILL END JP Z3 KEEP GOING TILL VARIABLE IS FILLED RET * * LOOK'S LIKE HE CAN'T EVEN ENTER A SIMPLE NUMBER, CLEAN UP ANY STACK * HE MAY HAVE USED, AND LET HIM TAKE ANOTHER BLIND STAB AT THE KEYBOARD * INERR LXI H,IERMS GET NASTY MESSAGE CALL PMSG GIVE HIM THE BAD NEWS LHLD TEMP GET HIS OLD STACK BACK SPHL RESET HIS STACK JMP RETRY LET HIM TRY AGAIN * * DIMENSION, HE WANTS SOME ARRAY SPACE.. I SUPPOSE WE SHOULD GIVE IT TO HIM * DIM MOV A,E GET ADDRESS OF OUR POSITION STA P SAVE IN POSITION POINTER DIM0 LDAX D GET CHARACTER FROM SOURCE INX D ADVANCE TO NEXT CPI $0D TEST FOR END OF LINE JZ SYNT IF SO, TELL HIM TO STRAIGHTEN UP CPI ')' TEST FOR START OF ARRAY DIMENSION JNZ DIM0 IF NOT, KEEP LOOKING DCX D BACK UP FOR EXPRESSION PUSH D SAVE BASIC PROGRAM COUNTER CALL DOEXP EVALUATE ARRAY SIZE INX H ADD ONE ENTRY (ZERO ENTRY DOES EXIST) DAD H DOUBLE BECAUSE THEY ARE 16 BIT'S DCX D BACK UP TO NAME MOV B,H COPY SIZE NEEDED MOV C,L INTO B AND C LHLD LAST GET FREE ADDRESS PUSH H SAVE FOR TABLE DLOOP MVI M,0 ZERO ARRAY BYTE INX H ADVANCE TO NEXT DCX B REDUCE COUNT MOV A,B GET HIGH BYTE OF REMAINING TO DO ORA C TEST FOR NONE LEFT JNZ DLOOP IF NOT, KEEP ZEROING SHLD LAST SAVE NEXT FREE SPACE INDICATOR POP H GET ADDRESS OF ARRAY BACK LDAX D GET ARRAY NAME CALL TABENT GET TABLE ENTRY MOV A,H GET HIGH ADDRESS STAX B PLACE IN TABLE INX B ADVANCE IN TABLE MOV A,L GET LOW ADDRESS STAX B PLACE IN TABLE POP D GET SOURCE POSITION BACK CALL PARSE ADVANCE TO NEXT NON-BLANK RZ CPI ',' TEST FOR ANOTHER OPERAND JZ DIM IF SO, KEEP GOING SUB A CAUSE A SYNTAX ERROR BECAUSE WE ARE BAD * * LOCATES TABLE POSITION OF AN ARRAY * TABENT CALL VCHAR INSURE IT'S OK SUI 'A' CONVERT TO BINARY ADD A X 2 FOR TWO BYTE ENTRIES MOV C,A SAVE IN C LDA ARYLOC GET ARRAY PAGE MOV B,A SAVE IN HIGH ZBYTE RET * LOOKS UP AN ARRAY VALUE ALOOK CALL DOEXP CALCULATE INDEX VALUE DCX D BACK UP PAST '[' LDAX D GET VARIABLE NAME CALL LOOKT FIND ADDRESS OF ENTRY MOV B,M GET HIGH BYTE OF ENTRY INX H ADVANCE TO LOW BYTE MOV C,M GET LOW BYTE OF ARRAY ENTRY MOV H,B TRANSFER RESULT TO . MOV L,C H AND L WHERE THEY ARE EXPECTED LDAX D GET VARIABLE NAME BACK CPI '@' TEST FOR MAGIC 'PEEK' ARRAY RNZ IF NOT, WE ARE OK MOV L,H SET VALUE TO THAT OF FIRST BYTE MVI H,0 AND ELIMINATE HIGH BYTE RET * * LOCATES ADDRESS OF AN ARRAY ENTRY IN THE ARRAY TABLE. INDEX IN HL * LOOKT CPI '@' TEST FOR SPECIAL CASE RZ IF SO, PEEK AT ADDRESS CALL TABENT LOCATE TABLE ENTRY PUSH D SAVE BASIC PROGRAM COUNTER LDAX B GET FIRST BYTE MOV D,A COPY TO HIGH BYTE INX B ADVANCE TO NEXT LDAX B GET LOW BYTE MOV E,A COPY TO D DAD H X TWO FOR TWO BYTE ENTRIES DAD D ADD IN OFFSET FOR START OF ARRAY ORA D TEST FOR ADDRESS OF ZERO, = NOT DIMENSIONED POP D RESTORE PROGRAM COUNTER RNZ NOT A DIMENSION ERROR, GO BACK * * EITHER HE'S TRIED TO INDEX A NON-ARRAY VARIABLE, TRIED TO INDEX A CHARACTER * VARIABLE WITH A VALUE GREATER THEN 34, OR HE'S PLOTTED OUTSIDE OF THE SCREEN * NO MATTER WHAT HE'S DONE, GIVE HIM A NASTY MESSAGE SO HE WON'T DO IT AGAIN * DIMERR LXI H,OVM ADDRESS OF NASTY MESSAGE JMP ERR GIVE IT TO HIM * LOCATES THE ADDRESS OF A CHARACTER (TEXT) VARIABLE LTA SUI $41 REDUCE TO SIMPLE BINARY CPI 26 TEST FOR VALID VARIABLE JNC SYNT IF NOT, GET MAD LXI H,VARS+25 START OF CHARACTER VARIABLES (-37) LXI B,37 LENGTH OF CHARACTER VARIABLES V1 DAD B OFFSET INTO TABLE DCR A REDUCE VARIABLES WE HAVE TO GO JP V1 IF NOT FINISHED, KEEP OFFSETING RET * * IT'S A 'USR' COMMAND, FIND OUT WHAT HE WANT'S, PASS CONTROL TO * HIS MACHINE LANGUAGE ROUTINE, AND GOD HELP HIM IF HE SCREW'S UP * BECAUSE WE CAN'T DO ANYTHING FOR HIM UNTIL HE RETURNS * USR LXI H,URET GET ON STACK (SO HE CAN 'RET' TO IT) PUSH H SAVE IN MACHINE STACK CALL EXPR EVALUATE ADDRESS PUSH H SAVE ON STACK (SO WE CAN 'RET' TO IT) LDAX D GET NEXT CHARACTER CPI ',' TEST FOR MORE PARAMETERS JNZ CSAV IF NOT, DONT EVALUATE INX D SKIP THE ',' CALL EXPR EVALUATE PARAMETER TO PASS * WHEN 'PUSHD' RETURNS, IT WILL EFFECT A JUMP TO HIS CODE CSAV JMP PUSHD SAVE PROGRAM POSITION * IF WE GET HERE, HE MADE IT BACK IN ONE PIECE URET CALL POPD GET PROGRAM COUNTER BACK LDAX D GET CHARACTER FROM SOURCE CPI ',' TEST FOR VARIABLE TO RECEIVE H-L RNZ IF NOT, WE ARE DONE CALL PARSE KEEP LOOKING * * STORES H-L INTO A INTEGER VARIABLE PASSED IN A * STOR MVI B,=VARS GET ADDRESS OF VARIABLE TABLE SUI $41 CONVERT TO BINARY CPI 26 TEST FOR VALID VARIABLE NAME JNC SYNT IF NOT, IT'S INVALID ADD A DOUBLE BECAUSE THEY ARE 16 BIT ENTRIES MOV C,A PLACE IN C, MAKING COMPLETE ADDRESS MOV A,L GET HIGH VALUE TO SAVE STAX B SAVE IN VARIABLE INX B NEXT BYTE OF VARIABLE MOV A,H GET LOW BYTE STAX B SAVE IN VARIABLE RET * * RETERIVES CONTENTS OF A VARIABLE * LOOK MVI B,=VARS ADDRESS OF VARIABLES SUI $41 CONVERT NAME TO BINARY ADD A DOUBLE FOR 16 BIT ENTRIES MOV C,A MAKE COMPLETE ADDRESS LDAX B GET HIGH BYTE MOV L,A PLACE IN H INX B NEXT BYTE OF VARIABLE LDAX B GET LOW BYTE MOV H,A PLACE IN L RET * * IT'S AN 'ORDER', (HE THINKS HE KNOWS WHERE THERE IS SOME DATA) * ORDER PUSH D SAVE OUR SOURCE POSITION CALL FNDLIN GET ADDRESS OF THE LINE HE WANTS POP D RESTORE OUR POSITION PUSH D AND RESAVE OUR POSITION JNZ BADLIN IF IT DOSN'T EXIST, THEN FORGET IT INX H SKIP FIRST TWO DIGITS OF LINE NUMBER INX H SKIP LAST TWO DIGITS OF LINE NUMBER INX H SKIP LENGTH BYTE XCHG MOVE TO D-E CALL VERDAT GET STATEMENT FROM LINE SHLD DATA SAVE DATA POINTER POP D RESTORE OUR LINE, (SO WE CAN TELL HIM) RZ * * DATA ERROR... ATTEMPT TO READ FROM A LINE WITHOUT 'DATA' OR * ATTEMPT TO READ THE WRONG DATA TYPE. LET HIM IN ON IT * DERR LXI H,DTXT ADDRESS OF 'DATA' MESSAGE JMP SYNT+3 DISPLAY IT * * IT'S A READ. (HE WANTS TO KNOW WHATS IN THAT DATA WE FOUND) * READ CALL VCHAR IS IT A VALID VARIABLE PUSH PSW SAVE VARIABLE NAME INX D ADVANCE TO NEXT CHARACTER LDAX D GET NEXT CHARACTER CPI '$' IS IT A CHARACTER VARIABLE? JZ CDAT IF SO, LOOK FOR CHARACTER DATA * NUMERIC DATA, FOR NUMERIC VARIABLE CALL GETDAT GET NUMERIC DATA JC DERR IF CHARACTER, IT A DATA TYPE ERROR POP PSW GET VARIABLE NAME BACK CALL STOR STASH VALUE IN IT JMP MORDAT SEE IF HE WANT'S MORE DATA * CHARACTER DATA, FOR CHARACTER VARIABLE CDAT INX D SKIP DOLLAR SIGN CALL GETDAT GET DATA JNC DERR IF NUMERIC, IT'S BAD POP PSW GET VARIABLE NAME BACK CALL LTA FIND IT'S ADDRESS LXI B,XBF DATA IS IN EXTRA BUFFER PUSH D SAVE SOURCE POSITION MVI E,35 MOVE 35 CHARACTERS SL1 LDAX B GET CHARACTER FROM BUFFER. (DATA) MOV M,A STASH IT IN THE VARIABLE INX B SKIP TO THE NEXT CHARACTER IN THE BUFFER INX H SKIP TO THE NEXT POSITION IN VARIABLE DCR E REDUCE COUNT OF HOW MANY TO MOVE JNZ SL1 IF NOT FINISHED, KEEP COPYING POP D RESTORE SOURCE POSITION * LOOK FOR MORE VARIABLES (OPERANDS) IN THE 'READ' STATEMENT MORDAT CALL PARSE1 FIND NEXT NON-BLANK CPI ',' IF COMMA.. RNZ IF NOT, WE HAVE ALL THERE IS CALL PARSE SKIP COMMA AND FIND VARIABLE NAME JMP READ GET MORE DATA FOR FOLLOWING VARIABLE * GETS DATA FROM THE DATA STATEMENTS, POINTED TO BY THE CURRENT READ POINTER GETDAT LHLD DATA GET DATA POINTER MOV A,H SEE IF IT IS ZERO. ORA L WHICH INDICATES THAT IT WASN'T INITIALIZED JZ DERR IF SO, IT'S A DATA ERROR PUSH D SAVE SOURCE POSIITION XCHG SWAP DATA POINTER TO D-E CALL EXPR EVALUATE THE DATA EXPRESSION PUSH PSW SAVE THE CONDITION FLAGS ENDAT LDAX D GET NEXT CHARACTER FROM THE SOURCE CPI ',' TEST FOR MORE DATA JZ COMA IF SO, WE ARE OK CPI ':' TEST FOR END OF STATEMENT JZ DAT1 GO TO NEXT DATA STATEMENT INX D ADVANCE ONE CHARACTER CPI $0D CARRIAGE RETURN? JNZ ENDAT KEEP LOOKING IF NOT * HIT THE END OF A LINE, SKIP TO NEXT DATA STATEMENT INX D SKIP FIRST TWO DIGITS INX D SKIP SECOND TWO DIGITS DAT1 INX D SKIP LENGTH (OR ':' IF STMT) PUSH H SAVE H-L REG CALL VERDAT CHECK FOR DATA STATEMENT XCHG SWAP POINTER BACK TO D-E POP H RESTORE REGISTERS JZ GDEND RETURN, WITH NEW DATA POINTER LXI D,$FFFF INDICATE NO MORE DATA STATEMENTS COMA INX D SKIP THE COMMA GDEND XCHG SWAP DATA POINTER BACK TO H-L SHLD DATA SAVE IN POINTER XCHG SWAP VALUE BACK TO H-L POP PSW GET FLAGS BACK POP D GET SOURCE POSITION BACK RET * * VERIFY THAT COMMAND WAS 'DATA' * VERDAT CALL PARSE1 SKIP TO COMMAND XCHG SWAP TO H-L LXI D,DATCMD POINT TO DATA COMMAND VER1 MOV A,E GET LOW ADDRESS CPI DATCMD+4 ARE WE AT END RZ LDAX D GET CHR FROM TABLE INX D ADVANCE TO NEXT ANI $7F INSURE IT'S CORRECT CMP M DUZ IT MATCH? INX H NEXT IN DATA COMMAND JZ VER1 OK, TEST NEXT RET * * HE WANT'S TO KNOW HOW BIG IT IS... LETS FIGURE IT OUT AND LET HIM IN ON IT * SIZE PUSH D SAVE PROGRAM POINTER CALL GETEOF FIND THE END OF THE FILE LXI B,0-TEXT GET THE (NEGATIVE) FILE START ADDRESS DAD B SUBTRACT FILE START FROM FILE END CALL DECPRT DISPLAY VALUE IN DECIMAL LXI H,SIMSG GET ' BYTES' MESSAGE POP D RESTORE PROGRAM POINTER JMP PMSG TELL HIM WHAT IT IS * FINDS THE END OF THE FILE, HL=LAST BYTE OF PGM., A=FIRST FREE PAGE GETEOF LXI H,TEXT START AT THE BEGINING MVI A,255 LOOKING FOR AN FF GLPX CMP M IS THIS IT? INX H ADVANCE TO NEXT JNZ GLPX IF NOT IT, KEEP LOOKING DCX H POINT BACK TO $FF MOV A,H GET HIGH VALUE INR A ADVANCE TO NEXT PAGE RET * * HE'S TRYING TO 'LOAD' SOMETHING, I WONDER IF HE HAS SOMETHING SAVED.. * LOAD CALL TON TURN ON TAPE AND WAIT LOD1 CALL GETR GET A RECORD JC LOD1 KEEP GOING TILL WE HAVE IT ALL CALL TOFF SHUT TAPE OFF JMP RESV CLEAR VARIABLES AND GET A NEW COMMAND * * HE'S TRYING TO 'SAVE' SOMETHING.. * SAVE PUSH D SAVE PROGRAM POINTER LXI D,TEXT GET ADDRESS OF TEXT LDAX D GET FIRST BYTE INR A TEST FOR NO PROGRAM JZ RUN IF SO, RUN WILL ABORT WITH ERROR CALL GETEOF GET ENDING ADDRESS CALL TDUMP DUMP PROGRAM AND RETURN POP D RESTORE PROGRAM POINTER RET * ***************************************************************** * EXPRESSION EVALUATION CODE ***************************************************************** * * EVALUATES 16 BIT DECIMAL NUMBERS * EVAL LXI B,1 MULTIPLIER IS ONE MOV H,B INITIALIZE MOV L,B STARTING RESULT TO ZERO ETOP LDAX D GET DIGIT FROM SOURCE CALL NUM TEST FOR INVALID DIGIT RC IF SO, WE ARE FINISHED ANI $0F CONVERT TO BINARY * ADD DIGIT TIMES MULTIPLIER IN B-C TO H-L ZLOOP DCR A REDUCE BY ONE JM ESP1 EXIT WHEN EXAUSTED DAD B ADD MULTIPLIER JMP ZLOOP CONTINUE TILL DONE * MULTIPLY MULTIPLIER (BC) BY 10 ESP1 PUSH H SAVE H-L MOV H,B GET B-C INTO MOV L,C H-L SO WE CAN USE 'DAD' DAD B BC=BC*2 DAD H BC=BC*4 DAD B BC=BC*5 DAD H BC=BC*10 MOV B,H SAVE BACK INTO MOV C,L B-C REGISTER PAIR POP H RESTORE H-L DCX D REDUCE POINTER IN SOURCE JMP ETOP EVALUATE NEXT CHARACTER * * SUBROUTINE TESTS FOR VALID ASCII CHARACTERS * CHAR CPI 'A' TEST FOR < 'A' RC RETURN SAYING IT'S BAD CPI '[' TEST FOR >'Z' CMC INVERT LOGIC RET * * PARSES FORWARD, SEARCHING FOR FIRST NON-BLANK CHARACTER * PARSE INX D ADVANCE IN SOURCE PARSE1 LDAX D GET CHARACTER FROM SOURCE CPI ' ' TEST FOR SPACE JZ PARSE KEEP LOOKING CPI ':' TEST FOR END OF STATEMENT RZ IF SO, RETURN WITH Z SET CPI $0D TEST FOR END OF LINE RET * * SKIPS TO NEXT EXPRESSION OR COMMAND * SKIP CALL PARSE1 ADVANCE TO NEXT NON-BLANK DCX D BACK UP TO POSITION MOV A,E GET LOW ORDER ADDRESS STA P SAVE IN POSITION BYTE * LOOK FOR DELIMITER SKIP1 INX D ADVANCE TO NEXT LDAX D GET CHARACTER CPI ':' TEST FOR DELIMITER RZ IF SO, RETURN CPI ',' TEST FOR DELIMITER RZ IF SO, RETURN CPI $0D TEST FOR DELIMITER RZ IF SO, RETURN CPI $22 TEST FOR QUOTE CZ SKPQUO IF SO, ADVANCE TO NEXT QUOTE JMP SKIP1 KEEP LOOKING * FIND NEXT QUOTE IN SOURCE SKPQUO INX D ADVANCE TO NEXT CHARACTER IN SOURCE LDAX D GET THE CHARACTER CPI $22 IS IT A QUOTE? RZ IF SO, WE FOUND IT CPI $0D IF IT A CARRIAGE RETUEN JNZ SKPQUO IF NOT, OK JMP SYNT UNMATCHED QUOTES WHILE PARSING * * EVALUATES AN EXPRESSION POINTED TO BY D-E. RETURN WITH CARRY SET * INDICATES THAT EXPRESSION WAS A CHARACTER EXPRESSION * EXPR CALL SKIP ADVANCE TO END OF EXPRESSION PUSH D SAVE POINTER TO END CALL DOEXP EVALUATE POP D RESTORE POINTER TO END OF EXPRESSION RET * CALCULATES EXPRESSION BACKWARDS (LIKE APL) DOEXP DCX D BACK UP IN SOURCE CALL FE GET CHARACTER FROM SOURCE CPI '$' TEST FOR CHARACTER VARIABLE JZ CEXP IF SO, ITS A CHARACTER EXPRESSION CPI $22 TEST FOR QUOTE JZ CEXP IF SO, IT'S A CHARACTER EXRESSION INX D ADVANCE MVI A,';' NULL OPERATOR TO START EGO1 PUSH H SAVE OLD VALUE PUSH PSW SAVE OPERATOR DCX D BACK UP TO VALUE CALL FE GET CHARACTER FROM SOURCE CPI ')' TEST FOR BRACKET JZ BRKTS IF SO, RECURSE CPI ']' TEST FOR ARRAY LOOKUP JZ ARYL IF SO, LOOK UP ARRAY VALUE CALL CHAR TEST FOR VARAIABLE JNC LOOKU IF SO, LOOK IT UP CPI '?' TEST FOR RANDOM NUMBER RETERIVAL JZ RANDR GET RANDOM VALUE CPI '#' TEST FOR HEX CONSTANT JZ HEXVL IF SO, GET HEV VALUE CALL NUM TEST FOR A NUMBER JC SYNT IF NOT, I DON'T KNOW WHAT HE'S DOING * DECIMAL NUMBER CALN CALL EVAL EVALUATE DECIMAL NUMBER JMP OLOOK LOOK FOR OPERATOR * HEX. NUMBER HEXVL DCX D BACK UP IN SOURCE LDA P GET ENDING POSITION CMP E TEST FOR PASSED THE LIMIT JZ HEXGO IF SO, THATS IT LDAX D GET CHARACTER FROM SOURCE CALL NUM TEST FOR VALID DIGIT JNC HEXVL KEEP GOING TILL WE GET TO START OF STRING SUI 'A' TEST FOR VALID LETTER CPI 6 OF 'A' TO 'F' JC HEXVL IF SO, KEEP LOOKING HEXGO LXI H,0 START WITH A ZERO MOV B,H FLAG TO SEE IF ANY DIGITS PUSH D SAVE POSITION IN SOURCE GETHX INX D ADVANCE TO NEXT DIGIT OF HEX NUMBER LDAX D GET DIGIT CPI '#' TEST FOR END OF STRING JZ HGON IF SO, WE ARE DONE MOV B,A SET FLAG SO WE KNOW WE GOT AT LEAST ONE DIGIT DAD H SHIFT H-L DAD H RIGHT IN ORDER DAD H TO MAKE ROOM FOR DAD H THE NEW DIGIT SUI '0' REDUCE TO BINARY CPI 10 TEST FOR FURTHER REDUCTION NEEDED JC HISG IF NOT, PROCESS SUI 7 CONVERT LETTER TO BINARY HISG ORA L ADD IN BOTTOM DIGIT OF RESULT MOV L,A REPLACE IN RESULT JMP GETHX GET NEXT DIGIT HGON POP D GET POSITION IN SOURCE BACK MOV A,B GET FLAG ANA A TEST FOR DIGIT'S PROCESSED JNZ OLOOK NO PROBLEM JMP SYNT '#' WITH NO DIGITS... ERROR * A ')' HAS BEEN DETECTED BRKTS CALL DOEXP RECURSE ON OURSELVES JMP DCLB CONTINUE WITH VALUE * LOOK UP AN ARRAY VALUE ARYL POP PSW GET OPERATOR BACK PUSH PSW STASH OPERATOR CPI '=' TEST FOR ASSIGNMENT CNZ ALOOK IF NOT, GET VALUE JMP DCLB CONTINUE WITH VALUE * GET VARIABLE CONTENTS LOOKU CALL LOOK LOOK UP VALUE OF VARIABLE DCLB DCX D BACK UP IN SOURCE OLOOK POP PSW GET OPERATOR BACK POP B GET OLD VALUE BACK * 16 BIT ADDITION CPI '+' TEST FOR ADDITION JZ ADD IF SO, PERFORM ADD * SIXTEEN BIT SUBTRACTION CPI '-' TEST FOR SUBTRACTION JNZ MULT NO, TRY MULTIPLICATION MOV A,B GET B CMA COMPLEMENT MOV B,A RESAVE MOV A,C GET C CMA COMPLEMENT MOV C,A RESAVE INX B ADD 1 GIVING TWO'S COMPLEMENT ADD DAD B ADD TO NEW VALUE JMP EGO CONTINUE * 16 BIT MULTIPLICATION MULT CPI '*' TEST FOR MULTIPLY JNZ DIV NO, TRY DIVIDE MOV A,B TEST OLD VALUE FOR ZERO ORA C AS IT IS A JZ EGZ SPECIAL CASE CALL DMULT PERFORM THE MULTIPLY JMP EGO AND CONTINUE * MULTIPLY SUBROUTINE (ALSO USED BY RANDOM NUMBER GENERATOR) DMULT PUSH D SAVE POSITION IN SOURCE LXI D,0 START OUT WITH A ZERO MUL1 ANA A INSURE CARRY CLEAR MOV A,B GET B RAR ROTATE MOV B,A RESAVE MOV A,C GET C RAR ROTATE WITH CARRY MOV C,A REPLACE PUSH PSW SAVE FLAGS ORA B TEST FOR B-C = ZER0 JZ MEXIT IF SO, WE ARE DONE POP PSW GET FLAGS BACK JNC NOMAD NO ONE BIT, DON'T ADD XCHG SWAP SO WE CAN DAD D ADD TO D-E XCHG AND SWAP BACK NOMAD DAD H SHIFT H-L RIGHT BY ONE BIT JMP MUL1 KEEP GOING MEXIT DAD D ADD RESULT POP PSW CLEAN UP STACK POP D RESTORE SOURCE POSITION RET * 16 BIT DIVISION DIV CPI '%' TEST FOR DIVIDE JNZ FLOR NO, TRY FLOR MOV A,B TEST FOR AN OLD ORA C VALUE OF ZERO, JZ DIVZE BECAUSE THAT IS A BAD THING PUSH D SAVE SOURCE POSITION CALL DODIV PERFORM DIVIDE OPERATION SHLD VARS+34 SET 'R' REMAINDER VARIABLE XCHG PLACE RESULT IN H-L POP D RESTORE SOURCE POSITION JMP EGO AND CARRY ON * * PERFORMS 16 BIT(HL) BY 16 BIT(BC) DIVIDE, RESULT IN DE, REM IN HL * DODIV MOV A,B GET CONTENTS OV B CMA INVERT MOV B,A REPLECE MOV A,C GET CONTENTS IN C CMA INVERT MOV C,A REPLACE INX B COMPLETE TWO COMPLEMENT OPERATION XCHG COPY HL TO DE, LOWER HALF OF 32 BIT VALUE LXI H,0 ZERO HIGHER HALF CALL DIVBYT PERFORM FIRST HALF DIVBYT MOV A,D GET UPPER HALF MOV D,E SAVE LOWER HALF MVI E,8 GET LOOP COUNT DIVTOP DAD H SHIFT LEFT JC OVER1 OVERFLOWED ADD A SHIFT RESULT JNC SUBB IF NO CARRY, DON'T INC INX H ADVANCE UPPER VALUE SUBB PUSH H SAVE VALUE DAD B SUBTRACT LOWER HALF OF FRACTION JC OKKK IF WRAP PAST ZERO POP H RESTORE VALUE JMP NXLP FINISH LOOP OKKK INX SP FIX UP INX SP STACK INR A ADVANCE RESULT JMP NXLP FINISH LOOP OVER1 ADC A SHIFT RESULT, +1 FOR CARRY JNC OVRSUB IF NO WRAP INX H INC. VALUE OVRSUB DAD B SUBTRACT LOWER NXLP DCR E REDUCE LOOP COUNTER JNZ DIVTOP LOOP IF NOT FINISHED MOV E,A LOWER BYTE OF RESULT RET * * HE SHOULD KNOW THAT HE CAN'T DIVIDE BY ZERO, BUT JUST IN CASE... * WE WILL TELL HIM ANYWAY * DIVZE LXI H,DER ADDRESS OF 'DIVIDE BYE ZERO MESSAGE' JMP ERR HANDLE LIKE ANY OTHER ERROR * COMPARES H-L TO B-C, Z=1 IF HL=BC, C=1 IF HL<BC COMP MOV A,H GET HIGH BYTE OF HL CMP B COMPARE WITH HIGH BYTE OF BC RNZ IF NOT SAME, LOWER BYTE CAN BE IGNORED MOV A,L GET LOW BYTE OF HL CMP C COMPARE WITH LOW BYTE OF BC RET * FLOOR, RETURNS THE LESSER OF THE TWO NUMBERS FLOR CPI '\' IS IT FLOOR? JNZ CEIL NO, TRY CEILING CALL COMP COMPARE NEW TO OLD JC EGO IF LESS, WE ARE OK (RESULT IS ALREADY IN HL) SWAP MOV H,B MAKE OLD NUMBER.. MOV L,C INTO THE NEW NUMBER.. JMP EGO CONTINUE * CEILING, RETURNS THE GREATER OF THE TWO NUMBERS CEIL CPI '/' IS IT CEILING? JNZ LAND NO, TRY LOGICAL AND CALL COMP COMPARE NEW AND OLD JNC EGO IF GREATER, WE ARE OK (RESULT ALREADY IN HL) JMP SWAP MAKE OLD NEW AND CONTINUE * LOGICAL AND LAND CPI '&' IF IT LOGICAL AND ? JNZ LOR NO, TRY LOGICAL OR MOV A,B GET HIGH BYTE OF OLD ANA H AND WITH HIGH BYTE OF NEW MOV H,A AND REPLACE HIGH BYTE OF NEW MOV A,L GET LOW BYTE OF OLD ANA C AND WITH LOW BYTE OF NEW JMP CPYL CONTINUE * LOGICAL OR LOR CPI '|' TEST FOR LOGICAL OR JNZ GRTR NO, TRY GREATER THAN MOV A,H GET HIGH BYTE OF NEW ORA B OR WITH HIGH BYTE OF OLD MOV H,A AND REPLACE HIGH BYTE OF NEW MOV A,L GET LOW BYTE OF NEW ORA C OR WITH LOW BYTE OF OLD CPYL MOV L,A AND REPLACE LOW BYTE OF NEW JMP EGO CONTINUE * GREATER THAN, RETURNS ONE OR ZERO GRTR CPI '>' TEST FOR GREATER THAN JNZ LETH IF NOT, TRY LESS THAN CALL COMP COMPARE OLD AND NEW JZ EGZ FALSE IF EQUAL JC EGZ FALSE IF LESS THAN JMP EG1 TRUE IF NOT LESS OR EQUAL * LESS THAN, RETURNS ONE OR ZERO LETH CPI '<' IS IT LESS THAN? JNZ ENOP NO, TRY NO-OP OPERATOR CALL COMP COMPARE OLD AND NEW JC EG1 TRUE IF LESS JMP EGZ FALSE IF NOT LESS * NO-OP OPERATOR, RETURNS NEW VALUE ONLY ENOP CPI ';' IS IT NO-OP? JZ EGO IF SO, DON'T DO ANYTHING * ASSIGNMENT, SET A VARIABLE'S VALUE ASST CPI '=' TEST FOR ASSIGNMENT JNZ EQUAL IF NOT, TRY EQUALITY STA EFLAG SET ASSIGNMENT FLAG INX D BACK UP TO VARIABLE NAME LDAX D GET VARIABLE CHARACTER CPI ']' TEST FOR ARRAY STORAGE JZ ASTOR IF SO, STORE INTO ARRAY MOV H,B GET OLD VALUE MOV L,C INTO H-L (WHERE STORE WANTS THEM) CPI '?' TEST FOR SETTING RANDOM SEED JZ SRSEED IF SO, SET THE SEED CALL STOR STORE VALUE INTO VARIABLE STRT DCX D STEP BACK FROM VARIABLE JMP EGO AND CONTINUE * SET THE RANDOM SEED SRSEED SHLD SEED SO WE CAN STORE IN SEED JMP STRT AND CONTINUE * SET THE VALUE OF AN ARRAY ELEMENT ASTOR PUSH H SAVE H-L CALL DOEXP CALCULATE INDEX VALUE DCX D BACK UP PAST '[' LDAX D GET ARRAY NAME CALL LOOKT LOOK UP IT'S ADDRESS IN THE TABLE MOV B,H GET ARRAY ADDRESS MOV C,L INTO B-C POP H RERSTORE H-L LDAX D GET ARRAY NAME BACK CPI '@' TEST FOR 'MAGIC', MEMORY REFERENCE JZ STMEM IF SO, SET MEMORY LOCATION MOV A,H GET HIGH BYTE OF VALUE STAX B STASH IN ARRAY INX B POINT TO NEXT STMEM MOV A,L GET LOW BYTE OF VALUE STAX B STASH IN ARRAY JMP STRT CONTINUE * TEST FOR EQUALITY. ('==') EQUAL SUI $81 IS A '=='? JNZ GEQL IF NOT, TRY GREATER OR EQUAL CALL COMP COMPARE OLD AND NEW JZ EG1 TRUE IF EQUAL JMP EGZ FALSE IF NOT EQUAL * GREATER OR EQUAL. ('>=') GEQL DCR A TEST FOR '>='? JNZ LEQL NO, TRY LESS OR EQUAL CALL COMP COMPARE OLD AND NEW JC EGZ FALSE IF LESS THAN JMP EG1 TRUE IF GREATER OR EQUAL * LESS OR EQUAL. ('<=') LEQL DCR A TEST FOR '<='? JNZ NEQL IF NOT, TRY NOT EQUAL CALL COMP COMPARE OLD AND NEW JZ EG1 TRUE IF SAME JC EG1 TRUE IF LESS THAN JMP EGZ FALSE OTHERWISE * TEST FOR NOT EQUAL. ('-=') NEQL DCR A IS IT '-='? JNZ SYNT BEATS ME WHAT IT IS! CALL COMP COMPARE OLD AND NEW JZ EGZ IF SAME, FALSE * RETURN RESULT OF ONE EG1 LXI H,1 SET RESULT TO ONE JMP EGO PASS ON RESULT * RETURN RESULT OF ZERO EGZ LXI H,0 SET RESULT TO ZERO * END OF OPERATION, GET NEXT OPERATOR EGO CALL FE GET NEXT CHARACTER RZ IF WE PASS BEGINNING OF EXPRESSION, QUIT CPI '(' ARE WE RETURNING FROM A NEST? RZ IF SO, BACK UP ONE LEVEL CPI '[' FINISHED AN ARRAY INDEX EVALUATION? RZ RETURN TO MAIN EXPRESSION CPI '=' IF IT A MULTI-CHARACTER OPERATOR JNZ EGO1 IF NOT, DON'T PRE-EVALUATE DCX D BACK UP TO PRECEDING CHARACTER LDAX D GET PRECEDING CHARACTER CPI '=' IS IT '=='? MVI B,$81 SET UNIQUE CODE JZ EGO2 IF '==' THEN WE HAVE IT INR B NEXT UNIQUE CODE CPI '>' IS IT '>='? JZ EGO2 IF SO, WE HAVE IT INR B NEXT UNIQUE CODE CPI '<' IS IT '<='? JZ EGO2 IF SO, WE HAVE IT INR B NEXT UNIQUE CODE CPI '-' IS IT '-='? JZ EGO2 IF SO, WE HAVE IT INX D WASN'T A TWO CHARACTER OPERATOR. BACK UP MVI A,'=' MUST HAVE BEEN A SIMPLE '=' JMP EGO1 CONTINUE EVALUATING EXPRESSION EGO2 MOV A,B SET OPERATOR TO OUR UNIQUE CODE JMP EGO1 AND CONTINUE EVALUATING EXPRESSION * FINDS NEXT CHARACTER IN EXPRESSION, SETS Z FLAG IF WE PASS THE BEGINNING FE LDA P GET ADDRESS OF BEGINNING OF LINE CMP E ARE WE THERE?? RZ IF SO, WE ARE FINISHED LDAX D GET CHARACTER FROM SOURCE CPI ' ' IS A (USELESS) BLANK? RNZ IF NOT, WE ARE FINISHED DCX D BACK UP ANOTHER CHARACTER JMP FE AND TRY AGAIN * CALCULATE A PSEUDO-RANDOM VALUE RANDR LHLD SEED GET RANDOM SEED MOV A,H GET HIGH BYTE OF SEED ANI $F7 AND WITH HIGH MASK PUSH PSW SAVE PARITY FLAG MOV A,L GET LOW BYTE OF SEED ANI $42 AND WITH LOW BYTE OF MASK PUSH PSW SAVE PARITY FLAG POP B GET FLAGS IN C MOV A,C COPY TO A POP B GET FIRST SET OF FLAGS IN C XRA C COMPUTE PARITY FOR ENTIRE WORD RRC MOVE COMPUTED RRC PARITY INTO RRC THE CARRY FLAG CMC COMP, SO SHIFT IN 1 IF EVEN MOV A,L GET LOW BYTE OF SEED RAL SHIFT IN CARRY, OUT HIGH BIT MOV L,A RESAVE MOV A,H GET HIGH BYTE OF SEED RAL SHIFT IN CARRY (HIGH BIT OF OLD LOWER) MOV H,A RESAVE SHLD SEED RESULT IS NEW SEED JMP DCLB KEEP GOING * * EVALUATES A CHARACTER EXPRESSION * CEXP CALL CLBF CLEAR EXTRA BUFFER INX D SKIP TO END OF EXPRESSION MVI A,'+' TO BEGIN, CONCATINATE A NULL STRING CG1 PUSH PSW STACK THE OPERATOR FOR LATER CALL PUSHB COPY NEW BUFFER INTO OLD BUFFER CALL CLBF CLEAR THE NEW BUFFER DCX D BACK UP IN SOURCE CALL FE GET CHARACTER AND TEST FOR END CPI $22 TEST FOR QUOTE JZ CQ IF SO, HANDLE QUOTED STRING CPI '$' TEST FOR CHARACTER VARIABLE JNZ SYNT IF NOT, IT'S NOT ANYTHING I RECOGNISE CV DCX D BACK UP PAST DOLLAR SIGN LDAX D GET VARIABLE NAME CPI ']' TEST FOR INDEX INTO CHARACTER VARIABLE JZ CINDX GET INDEX VALUE CALL LTA GET ADDRESS OF VARIABLE PUSH D SAVE SOURCE POSITION XCHG SWAP ADDRESS TO D-E DCX D BACK UP IN SOURCE JMP Q0 SAVE VARIABLE IN NEW BUFFER * BACKUP TO PRECEDING QUOTE CQ DCX D BACKUP IN SOURCE LDAX D GET CHARACTER FROM SOURCE CPI $0D TEST FOR END OF LINE JZ SYNT IF SO, THERE IS NO CLOSEING QUOTE CPI $22 TEST FOR CLOSEING QUOTE JNZ CQ IF NO, KEEP LOOKING PUSH D SAVE ENDING POSITION Q0 LXI H,XBF GET ADDRESS OF NEW (EXTRA) BUFFER Q1 INX D ADVANCE TO SOURCE OR VARIABLE CHARACTER LDAX D GET CHARACTER CPI $22 TEST FOR CLOSEING QUOTE JZ Q2 IF SO, STOP COPYING CPI $FF TEST FOR END OF VARIABLE JZ Q2 IF SO, STOP COPYING MOV M,A SAVE IN BUFFER INX H ADVANCE IN BUFFER JMP Q1 KEEP COPYING Q2 POP D GET POSITION BACK Q3 DCX D BACK UP TO OPERATOR POP PSW GET OPERATOR CPI '+' TEST FOR CONCATIONATION JNZ Q5 NO, TRY ASSIGNMENT * CONCATONATION. XBF=XBF+TB QPP LXI B,TB ADDRESS OF TEMPORARY BUFFER Q4 LDAX B GET CHARACTER FROM BUFFER MOV M,A MOVE TO BUFFER INX B ADVANCE IN OLD INX H ADVANCE IN NEW MOV A,C GET ADDRESS IN OLD CPI TB+35 TEST FOR OVER JC Q4 IF SO, STOP LHLD XBF GET CHARACTER FROM BUFFER MVI H,0 SET HIGH BYTE TO ZERO JMP Q9 CONTINUE * ASSIGNMENT Q5 CPI '=' TEST FOR ASSIGNMENT JNZ Q6 IF NOT, TRY EQUALITY INX D SKIP TO VARIABLE NAME INX D SKIP TO DOLLARSIGN LDAX D GET DOLLARSIGN DCX D BACK UP TO VARIABLE NAME CPI '$' TEST FOR DOLLAR SIGN JNZ SYNT IF NOT, THIS AIN'T NO CHARACTER VARIABLE STA EFLAG SET ASSIGNMENT FLAG LDAX D GET VARIABLE NAME DCX D BACK UP BAST NAME CALL LTA GET IT'S ADDRESS JMP QPP COPY IT OVER * TEST FOR EQUALITY Q6 CPI $81 TEST FOR '==' JNZ X0 NO, TRY '=-' CALL COMSTR COMPARE STRINGS JMP Q9 CONTINUE * COMPARES STRINGS. SETS H-L TO 1 OR 0 IF EQUAL OR NOT EQUAL COMSTR LXI B,TB GET ADDRESS OF OLD STRING LXI H,XBF ADDRESS OF NEW STRING Q7 LDAX B GET CHARACTER FROM OLD CMP M TEST AGAINST NEW JNZ Q8 IF NOT, THEY ARE UNEQUAL INX B NEXT PLACE IN OLD INX H NEXT PLACE IN NEW INR A TEST FOR END OF STRING JNZ Q7 IF NOT, CONTINUE TESTING LXI H,1 INDICATE THEY ARE EQUAL RET Q8 LXI H,0 INDICATE NOT EQUAL RET * NOT EQUAL .. '-=' X0 CPI $82 TEST FOR '-=' JNZ SYNT BEATS ME, BUT IT ISN'T RIGHT CALL COMSTR TEST STRINGS MOV A,L GET RESULT XRI 1 AND COMPLEMENT IT MOV L,A REPLACE IN RESULT * GET NEXT STRING Q9 CALL FE GET NEXT CHARACTER STC INDICATE CHARACTER EXPRESSION RZ IF END OF LINE, QUIT CPI '(' TEST FOR END OF NUMERIC SUBSTRING RZ QUIT, INDICATING NUMBERIC RESULT CPI '=' TEST FOR EQUAL,ASSIGNMENT, OR NOT EQUALS JNZ CG1 NO, NO NEED TO TEST FURTHER QTST DCX D BACK UP TO PREVIOUS CHARACTER LDAX D GET CHARACTER MOV B,A SAVE FOR COMPARISON CPI '=' TEST FOR '==' MVI A,$81 INDICATE '==' JZ CG1 CONTINUE MOV A,B GET CHARACTER BACK CPI '-' TEST FOR '-=' MVI A,$82 INDICATE '-=' JZ CG1 CONTINUE INX D ADVANCE BACK TO PREVIOUS CHARACTER MVI A,'=' INDICATE '=' JMP CG1 CONTINUE * CLEARS THE TEXT BUFFER CLBF LXI H,XBF GET ADDRESS OF BUFFER MVI A,40 CLEAR FOR LENGTH OF 40 CL2 MVI M,$FF CLEAR TO NULL CHARACTER INX H NEXT POSITION IN BUFFER DCR A REDUCE COUNT OF REMAINING JNZ CL2 KEEP GOING TILL WE ARE FINISHED RET * COPY'S NEW BUFFER INTO OLD BUFFER PUSHB PUSH D SAVE POSITION IS SOURCE LXI D,XBF GET ADDRESS OF NEW BUFFER LXI H,TB GET ADDRESS OF OLD BUFFER MVI B,40 COPY 40 CHARACTERS PU1 LDAX D GET CHARACTER FROM NEW MOV M,A SAVE IN OLD INX H NEXT POSITION IN OLD INX D NEXT POSITION IN NEW DCR B REDUCE COUNT JNZ PU1 KEEP GOING TILL 40 ARE MOVED POP D RESTORE POSITION IN SOURCE RET * INDEXED CHARACTER VARIABLE, EXTRACT A SINGLE CHARACTER CINDX CALL DOEXP EVALUATE INDEX EXPRESSION MOV A,L GET INDEX VALUE PUSH PSW SAVE INDEX VALUE DCX D BACK UP TO VARIABLE NAME LDAX D GET VARIABLE NAME CPI '@' TEST FOR 'MAGIC' CHR$ VARIABLE JZ CHR IF SO, HANDLE SPECIAL CASE CALL LTA GET TEXT VARIABLE ADDRESS POP PSW GET INDEX BACK CPI 35 TEST FOR TOO BIG JNC DIMERR IF SO, TELL HIM HE SCREWED UP MOV C,A GET INTO A DOUBLE PAIR DAD B SO WE CAN DAD IT TO THE ADDRESS MOV A,M AND GET THE CHARACTER FILBUF LXI H,XBF ADDRESS OF TEXT BUFFER MOV M,A PLACE CHARACTER THERE INX H BUMP TO NEXT POSITION JMP Q3 AND FILL WITH NULLS * * 'MAGIC' CHARACTER ARRAY, RETURNS CHARACTER WITH VALUE OF IT'S INDEX * CHR POP PSW GET INDEX VALUE JMP FILBUF SAVE IN BUFFER AND PAD WITH NULLS * END OF BASIC INTERPRETER CODE SECTION PAGE * ********************************************************************** * COMMAND TABLE * * FORMAT IS: * COMMAND WORDS, HIGH BIT SET ON LAST CHARACTER * ADDRESS OF COMMAND PROCESSOR FOLLOWES * ENTRY OF HEX 00 INDICATES LAST ENTRY IN TABLE (DEFAULT) * ********************************************************************** * * COMMANDS ALLOWED ONLY FROM WITHING A PROGRAM.. PTAB STR 'NEX' DB 'T'+$80 DW NEXT STR 'THE' DB 'N'+$80 DW THEN STR 'GOSU' DB 'B'+$80 DW GOSUB STR 'RETUR' DB 'N'+$80 DW RETURN STR 'FO' DB 'R'+$80 DW FOR STR 'I' DB 'F'+$80 DW IF DATCMD STR 'DAT' DB 'A'+$80 DW RNEXT STR 'LI' DB 'F'+$80 DW LIF * COMMANDS ALLOWED FROM BOTH A PROGRAM, AND INTERACTIVE KEYBOARD ENTRY KTAB STR 'GOT' DB 'O'+$80 DW GOTO STR 'LE' DB 'T'+$80 DW LET STR 'PRIN' DB 'T'+$80 DW PRINT STR 'US' DB 'R'+$80 DW USR STR 'REA' DB 'D'+$80 DW READ STR 'PLO' DB 'T'+$80 DW PLOT STR 'RE' DB 'M'+$80 DW REM STR 'DI' DB 'M'+$80 DW DIM STR 'RU' DB 'N'+$80 DW RUN STR 'ORDE' DB 'R'+$80 DW ORDER STR 'INPU' DB 'T'+$80 DW INPUT STR 'CLEA' DB 'R'+$80 DW CLEAR STR 'STO' DB 'P'+$80 DW STOP STR 'EN' DB 'D'+$80 DW INIT STR 'LIS' DB 'T'+$80 DW LIST STR 'NE' DB 'W'+$80 DW NEW STR 'SIZ' DB 'E'+$80 DW SIZE STR 'LOA' DB 'D'+$80 DW LOAD STR 'SAV' DB 'E'+$80 DW SAVE STR 'EXI' DB 'T'+$80 DW EXIT DB 0 UNRECOGNIZED COMMAND, ASSUME 'LET' DW LET * *************************************************************** * STRINGS AND MESSAGES *************************************************************** * * ERROR MESSAGES.. * DER STRZ 'DIVIDE BY ZERO' DIVIDE BY ZERO IERMS STR 'BAD DATA - RETRY' BAD RESPONSE TO INPUT STATEMENT DB $0D CSTK STRZ 'NESTING' INVALID FOR/NEXT, GOSUB/RETURN NESTING LIN STRZ 'LINE NUMBER' GOTO, GOSUB, OR ORDER TO UNKNOWN LINE NP STRZ 'NO PROGRAM' RUN OR SAVE EMPTY PROGRAM INL STRZ ' IN LINE ' INDICATES LINE ERROR WAS IN SYN STRZ 'SYNTAX' DOES NOT FOLLOW SYNTAX RULES DTXT STRZ 'DATA' BAD LINE OR DATA TYPE OVM STRZ 'DIMENSION' TO MANY ARRAYS, ARGUMENT OUT OF RANGE * * INFORMATIONAL MESSAGES.. * RDY STR 'READY' READY PROMPT DB $0D STMSG STRZ 'STOP' INDICATES PROGRAM STOPPED EM STRZ ' ERROR' INDICATES ERROR OCCURED SIMSG STR ' BYTES' DISPLAYED IN RESPONSE TO 'SIZE' DB $0D ENDIT EQU *